home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagn_r.zip / OOP.SWG / 0043_Defining array sizes.pas < prev    next >
Pascal/Delphi Source File  |  1994-08-25  |  4KB  |  172 lines
  1. {
  2.  RJS> Just a quick question... In the variable declaration field, you define
  3.  RJS> an array with array [0..9] of foo, But let's say I didn't know exactly
  4.  RJS> how big the array was going to be... How would I declare an array with
  5.  RJS> a variable endpoint?
  6.  
  7. There are a couple of ways around this, and they employ the use of pointers,
  8. which in turn, require a little additional code to maintain. If you are useing
  9. Borlands Pascal 6 or 7, the tCollection objects work quite well, or else make
  10. use of linked lists. There is still the option of using a variable lengthed
  11. array too.
  12.  
  13. As an example,
  14. }
  15. {$A+,B-,D-,E-,F+,G-,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X+,Y-}
  16. {$M 16384,0,655360}
  17. Program VariableArrayETC;
  18. uses objects;
  19. Type
  20.    Data = Record
  21.             name : string[80];
  22.             age  : integer;
  23.           end;
  24.  
  25.   VArray = array[0..0] of Data;   {variable sized array}
  26.   VAPtr  = ^Varray;
  27.  
  28.   VLPtr = ^VList;                 {linked list}
  29.   VList = Record
  30.             rec : Data;
  31.             next,
  32.             prev: VLPtr;
  33.           end;
  34.  
  35.   DataPtr = ^data;                {OOP types from the objects unit}
  36.   VObj    = Object(tCollection)
  37.               procedure FreeItem(item:pointer); virtual;
  38.             end;
  39.   VObjPtr = ^VObj;
  40.               Procedure VObj.FreeItem(item:pointer);
  41.                  begin
  42.                    dispose(DataPtr(item));
  43.                  end;
  44.  
  45.  
  46. procedure MakeTestFile;
  47.    var i:integer;
  48.        f:file of Data;
  49.        d:data;
  50.    Begin
  51.      writeln;
  52.      writeln('blank name will exit');
  53.      assign(f,'test.dat');
  54.      rewrite(f);
  55.      fillchar(d,sizeof(d),0);
  56.      repeat
  57.        write('name : '); readln(d.name);
  58.        if   d.name <> ''
  59.        then begin
  60.               repeat
  61.                 write('age : '); readln(d.age);
  62.               until ioresult = 0;
  63.               write(f,d);
  64.             end;
  65.      until d.name = '';
  66.      close(f);
  67.    End;
  68.  
  69. Procedure VariableArrayExample; {turn Range Checking off...}
  70.    var f:file;
  71.        v:VAPtr;
  72.        i,res:integer;
  73.        d:data;
  74.        m:longint;
  75.    Begin
  76.      writeln;
  77.      Writeln('output of variable array ... ');
  78.      m := memavail;
  79.      assign(f,'test.dat');
  80.      reset(f,sizeof(data));
  81.      getmem(v,filesize(f)*SizeOf(Data));
  82.      blockRead(f,v^,filesize(f),res);
  83.      for i := 0 to res - 1 do
  84.         begin
  85.           writeln(v^[i].name);
  86.           writeln(v^[i].age);
  87.         end;
  88.      freemem(v,filesize(f)*SizeOf(Data));
  89.      close(f);
  90.      if m <> memavail then writeln('heap ''a trouble...');
  91.    End;
  92.  
  93. Procedure LinkedListExample;
  94.    var f:file of Data;
  95.        curr,hold : VLPtr;
  96.        m:longint;
  97.    Begin
  98.      curr := nil; hold := nil;
  99.      writeln;
  100.      writeln('Linked List example ... ');
  101.      m := memavail;
  102.      assign(f,'test.dat');
  103.      reset(f);
  104.      while not eof(f) do
  105.         begin
  106.           new(curr);
  107.           curr^.prev := hold;
  108.           read(f,curr^.rec);
  109.           curr^.next := nil;
  110.           if hold <> nil then hold^.next := curr;
  111.           hold := curr;
  112.         end;
  113.     close(f);
  114.     hold := curr;
  115.     if   hold <> nil
  116.     then begin
  117.            while hold^.prev <> nil do hold := hold^.prev;
  118.            while hold <> nil do
  119.            begin
  120.              writeln(hold^.rec.name);
  121.              writeln(hold^.rec.age);
  122.              hold := hold^.next;
  123.            end;
  124.            hold := curr;
  125.            while hold <> nil do
  126.              begin
  127.                hold := curr^.prev;
  128.                dispose(curr);
  129.                curr := hold;
  130.              end;
  131.          end;
  132.     if m <> memavail then writeln('heap ''a trouble...');
  133.   End;
  134.  
  135. Procedure tCollectionExample;  {requires the object unit}
  136.    var p:VObjPtr;
  137.        d:DataPtr;
  138.        f:file of Data;
  139.        m:longint;
  140.    procedure WriteEm(dp:DataPtr); far;
  141.       begin
  142.         writeln(dp^.name);
  143.         writeln(dp^.age);
  144.       end;
  145.    begin
  146.      writeln;
  147.      writeln('object tCollection example ... ');
  148.      m := memavail;
  149.      assign(f,'test.dat');
  150.      new(p,init(5,2));
  151.      reset(f);
  152.      while not eof(f) do
  153.         begin
  154.           new(d);
  155.           system.read(f,d^);
  156.           p^.insert(d);
  157.         end;
  158.      close(f);
  159.      p^.forEach(@WriteEm);
  160.      dispose(p,done);
  161.      if m <> memavail then writeln('heap ''a trouble...');
  162.   end;
  163.  
  164.  
  165. Begin
  166.   maketestfile;
  167.   variablearrayexample;
  168.   linkedListExample;
  169.   tcollectionExample;
  170. End.
  171.  
  172.